home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / oobr / br-clos-ft.el < prev    next >
Encoding:
Text File  |  1995-08-26  |  21.1 KB  |  578 lines
  1. ;;!emacs
  2. ;;
  3. ;; FILE:         br-clos-ft.el
  4. ;; SUMMARY:      CLOS OO-Browser class and element functions.
  5. ;; USAGE:        GNU Emacs Lisp Library
  6. ;; KEYWORDS:     lisp, oop, tools
  7. ;;
  8. ;; AUTHOR:       Bob Weiner
  9. ;; ORG:          Motorola Inc.
  10. ;;
  11. ;; ORIG-DATE:    03-Oct-90
  12. ;; LAST-MOD:      6-Aug-95 at 01:52:28 by Bob Weiner
  13. ;;
  14. ;; Copyright (C) 1990-1995  Free Software Foundation, Inc.
  15. ;; See the file BR-COPY for license information.
  16. ;;
  17. ;; This file is part of the OO-Browser.
  18. ;;
  19. ;; DESCRIPTION:  
  20. ;; DESCRIP-END.
  21.  
  22. ;;; ************************************************************************
  23. ;;; Other required Elisp libraries
  24. ;;; ************************************************************************
  25.  
  26. (mapcar 'require '(br-clos set))
  27.  
  28. ;;; ************************************************************************
  29. ;;; Public variables
  30. ;;; ************************************************************************
  31.  
  32. (defconst clos-type-identifier
  33.   (concat "[" clos-type-identifier-chars "]+"))
  34.  
  35. (defconst clos-type-tag-separator ","
  36.   "String that separates a tags type from its normalized definition form.")
  37.  
  38. (defconst clos-def-form-match "\([^ \t\n\r]+[ \t\n\r]+")
  39.  
  40. (defconst clos-feature-tag-regexp
  41.   (concat "\\(" clos-type-identifier "\\)"
  42.       clos-type-tag-separator
  43.       clos-def-form-match "['\(]?"
  44.       "\\((setf[^\)]+)\\|[^\(;,]+\\)\\( *(.*)\\)?")
  45.   "Regexp matching a fully qualified, normalized clos feature tag.
  46. Class name is grouping 1.  Feature name is grouping 2.  Optional
  47. argument list (aliased features don't have one) is grouping 3.")
  48.  
  49. ;;; ************************************************************************
  50. ;;; Public functions
  51. ;;; ************************************************************************
  52.  
  53. (defun clos-add-default-classes ()
  54.   ;; Add to 'system' class table.
  55.   (let ((classes (set:create (mapcar 'cdr clos-element-type-alist))))
  56.     ;; Methods are broken out into individual classes, so don't add "method"
  57.     ;; as a default class.
  58.     (setq classes (set:remove "method" classes))
  59.     (mapcar
  60.      (function (lambda (class)
  61.          (br-add-class (concat "[" class "]")
  62.                    br-null-path nil)))
  63.      classes)))
  64.  
  65. (defun clos-class-routine-to-regexp (class routine-name args)
  66.   "Return regexp matching definition of CLASS's ROUTINE-NAME with ARGS.
  67. ARGs should be a string or nil if routine definition had no argument list,
  68. i.e. an alias."
  69.   (setq class (regexp-quote class)
  70.     routine-name (regexp-quote routine-name)
  71.     args (if (stringp args) (regexp-quote args) args))
  72.   ;; Search for CLOS method definition based on first typed argument.
  73.   (concat "(defmethod[ \t\n\r]+"
  74.       routine-name "[ \t\n\r]"
  75.       ;; Alias defmethods don't have an argument list, so don't
  76.       ;; try to find one unless signature had an argument list.
  77.       (if (not args)
  78.           "+"
  79.         (concat "*[^\)]*[ \t\n\r]" class "[ \t\n\r]*\)"))
  80.       "\\|"
  81.       ;; Search for BWlib routine definition where class name is
  82.       ;; prepended with a colon to the routine name.
  83.       (concat "(defmethod[ \t\n\r]+" class ":" routine-name
  84.           "[ \t\n\r]"
  85.           ;; BWlib alias defmethods don't have an argument list,
  86.           ;; so don't try to find one unless signature had an
  87.           ;; argument list.
  88.           (if (not args) "+" "*\("))))
  89.  
  90. (defun clos-feature-implementors (ftr-name)
  91.   "Return unsorted list of clos feature tags which implement FTR-NAME."
  92.   (if (string-match "[ \t]+$" ftr-name)
  93.       (setq ftr-name (substring ftr-name 0 (match-beginning 0))))
  94.   (clos-feature-matches (concat "^" (regexp-quote ftr-name) "$")))
  95.  
  96. (defun clos-feature-locate-p (feature-tag)
  97.   (let (start)
  98.     (if (not (re-search-forward
  99.           (clos-feature-signature-to-regexp feature-tag) nil t))
  100.     nil
  101.       (setq start (match-beginning 0))
  102.       (goto-char start)
  103.       (skip-chars-forward " \t\n")
  104.       (clos-to-comments-begin)
  105.       (recenter 0)
  106.       (goto-char start)
  107.       t)))
  108.  
  109. (defun clos-feature-name-to-regexp (name)
  110.   "Converts feature NAME into a regular expression matching the feature's name tag."
  111.   (if (string-match (concat "^" br-feature-type-regexp " ") name)
  112.       (setq name (substring name (match-end 0))))
  113.   (format "%s%s\(\\(%s\\) %s[ \n]"
  114.       clos-type-identifier clos-type-tag-separator clos-def-form-regexp
  115.       (regexp-quote name)))
  116.  
  117. (defun clos-feature-signature-to-name (signature &optional with-class for-display)
  118.   "Extracts the feature name from SIGNATURE.
  119. The feature's class name is dropped from signature unless optional WITH-CLASS
  120. is non-nil.  If optional FOR-DISPLAY is non-nil, a \"- \" is prepended to
  121. the name for display in a browser listing."
  122.   (concat (if for-display "- ")
  123.       (clos-feature-partial-name signature with-class)))
  124.  
  125. (defun clos-feature-signature-to-regexp (signature)
  126.   "Given a clos element SIGNATURE, return regexp to match its definition."
  127.   (cond ((string-match (concat "\\`[^ \t\n\r;]+" clos-type-tag-separator)
  128.                signature)
  129.      (clos-element-def-to-regexp
  130.       (substring signature (match-end 0))))
  131.     ((string-match (concat "\\(" clos-arg-identifier "\\):\\("
  132.                    clos-element-identifier
  133.                    "\\)[ \t\n\r]*\\(\(\\)?")
  134.                signature)
  135.      (clos-class-routine-to-regexp
  136.       (substring signature (match-beginning 1) (match-end 1))
  137.       (substring signature (match-beginning 2) (match-end 2))
  138.       (if (= ?\( (elt signature (match-end 0)))
  139.           (substring signature (match-beginning 3)))))))
  140.  
  141. (defun clos-feature-tree-command-p (class-or-signature)
  142.   "Display definition of CLASS-OR-SIGNATURE if a signature and return t, else return nil."
  143.   (if (br-in-browser) (br-to-view-window))
  144.   (br-feature-found-p (br-feature-file class-or-signature)
  145.               class-or-signature))
  146.  
  147. (defun clos-list-features (class &optional indent)
  148.   "Return sorted list of clos feature names lexically defined in CLASS."
  149.   (let ((obuf (current-buffer))
  150.     (class-tag (concat "\n" class clos-type-tag-separator))
  151.     (features))
  152.     (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
  153.     (goto-char 1)
  154.     ;; Feature defs (methods) for a single class could occur in any file,
  155.     ;; according to Common Lisp rules.
  156.     (while (search-forward class-tag nil t)
  157.       (setq features (cons (br-feature-current) features)))
  158.     (set-buffer obuf)
  159.     (clos-sort-features (nreverse features))))
  160.  
  161. (defun clos-scan-features ()
  162.   "Return reverse ordered list of clos feature definitions in current buffer.
  163. Assume point is at the beginning of a widened buffer."
  164.   (save-excursion
  165.     (let ((features) (tag-list)
  166.       ;; t if current file is an Emacs Lisp file and therefore may
  167.       ;; contain BWlib method definitions.  BWlib is a simple CLOS-like
  168.       ;; object system for Emacs Lisp written by the author of the
  169.       ;; OO-Browser for use in InfoDock, but not yet released.
  170.       (bwlib-flag (and buffer-file-name
  171.                (string-match "\\.el$" buffer-file-name)
  172.                t))
  173.       def-form)
  174.       (while (re-search-forward clos-element-def nil t)
  175.     (setq tag-list (mapcar
  176.             'clos-feature-normalize
  177.             (clos-element-tag-list
  178.              (setq def-form
  179.                    (buffer-substring
  180.                 (match-beginning clos-def-form-grpn)
  181.                 (match-end clos-def-form-grpn)))
  182.              (buffer-substring (match-beginning clos-feature-grpn)
  183.                        (match-end clos-feature-grpn))
  184.              (if (string-match clos-def-form-with-args-regexp
  185.                        def-form)
  186.                  (clos-scan-routine-arglist))
  187.              bwlib-flag))
  188.           features (nconc features tag-list)))
  189.       features)))
  190.  
  191. (defun clos-scan-routine-arglist ()
  192.   "Return list of routine's formal parameters.  Leaves point after arglist.
  193. Requires that caller has left point in front of arglist.
  194. If routine is an alias, get argument list from the routine aliased, if
  195. defined, else return nil."
  196.   (skip-chars-forward " \t\n\r")
  197.   (if (= (following-char) ?\()
  198.       (buffer-substring (point) (progn (progn (forward-list) (point))))
  199.     ;; No arglist, treat as an alias.
  200.     (let ((aliased-function (read (current-buffer)))
  201.       arg-list)
  202.       (setq aliased-function
  203.         (condition-case ()
  204.         (cond ((fboundp 'indirect-function)
  205.                (indirect-function aliased-function))
  206.               ((fboundp 'hypb:indirect-function)
  207.                (indirect-function aliased-function))
  208.               (t aliased-function))
  209.           (void-function nil)))
  210.       (if (null aliased-function)
  211.       nil
  212.     (setq arg-list
  213.           (cond ((fboundp 'action:params)
  214.              (action:params aliased-function))
  215.             ((listp aliased-function)
  216.              (if (eq (car aliased-function) 'autoload)
  217.              (error "(clos-scan-routine-arglist): Arglist unknown for autoload functions: %s" aliased-function)
  218.                (car (cdr aliased-function))))
  219.             ((funcall (if (fboundp 'compiled-function-p)
  220.                   'compiled-function-p
  221.                 'byte-code-function-p)
  222.                   aliased-function)
  223.              ;; Turn into a list for extraction
  224.              (car (cdr (cons nil (append aliased-function nil)))))))
  225.     (if arg-list (prin1-to-string arg-list))))))
  226.  
  227. (defun clos-sort-features (feature-list)
  228.   (sort feature-list 'clos-feature-lessp))
  229.  
  230. ;; !! Need to write clos-to-definition function.
  231. ;;    Move from an identifier to its definition as best as possible.
  232. ;;    Use the following temporarily.
  233. (fset 'clos-to-definition 'smart-lisp)
  234.  
  235. ;;; ************************************************************************
  236. ;;; Private functions
  237. ;;; ************************************************************************
  238.  
  239. (defun clos-element-def-to-regexp (element-def)
  240.   "Convert a normalized clos element definition to a regular expression that will match to its definition in the source code."
  241.   (setq element-def (regexp-quote element-def))
  242.   (mapconcat (function (lambda (c)
  243.              (if (= c ?\ )
  244.                  "[ \t\n\r]+\\(;.*[ \t\n\r]+\\)?"
  245.                (char-to-string c))))
  246.          element-def nil))
  247.  
  248. (defun clos-feature-def-p ()
  249.   "Return nil unless point is within a feature definition.
  250. If point is within a comment, return nil.
  251. Leaves point at start of the definition for visual clarity."
  252.   (if (clos-skip-to-statement)
  253.       (looking-at "\(def")))
  254.  
  255. (defun clos-feature-partial-name (signature &optional with-class)
  256.   "Extract the feature name without its class name from feature SIGNATURE.
  257. If optional WITH-CLASS is non-nil, class name and 'clos-type-tag-separator'
  258. are prepended to the name returned."
  259.   (if (string-match clos-feature-tag-regexp signature)
  260.       (let ((class (substring signature
  261.                   (match-beginning 1) (match-end 1)))
  262.         (name (substring signature (match-beginning 2)
  263.                  (match-end 2))))
  264.     (setq name (br-delete-space name))
  265.     (if (string-match (concat "\\`" class ":") name)
  266.         (setq name (substring name (match-end 0))))
  267.     (if with-class
  268.         (concat class clos-type-tag-separator name)
  269.       name))
  270.     signature))
  271.  
  272. (defun clos-feature-lessp (routine1 routine2)
  273.   (string-lessp (clos-feature-partial-name routine1)
  274.         (clos-feature-partial-name routine2)))
  275.     
  276. (defun clos-feature-matches (regexp)
  277.   "Return an unsorted list of feature tags whose names match in part or whole to REGEXP."
  278.   ;; Ensure match to feature names only; also handle "^" and "$" meta-chars
  279.   (setq regexp
  280.     (concat "^\\(" clos-type-identifier "\\)"
  281.         clos-type-tag-separator
  282.         clos-def-form-match "['\(]?"
  283.         (if (equal (substring regexp 0 1) "^")
  284.             (progn (setq regexp (substring regexp 1)) nil)
  285.           (concat "[" clos-identifier-chars "]*"))
  286.         (if (equal (substring regexp -1) "$")
  287.             (substring regexp 0 -1)
  288.           (concat regexp "[" clos-identifier-chars "]*"))
  289.         "[ \t\n\r]"))
  290.   (save-excursion
  291.     (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
  292.     (goto-char 1)
  293.     (let ((features))
  294.       (while (re-search-forward regexp nil t)
  295.     (backward-char) ;; Might have moved past newline.
  296.     (setq features (cons (br-feature-current) features)))
  297.       features)))
  298.  
  299. (defun clos-feature-normalize (routine)
  300.   (let* ((len (length routine))
  301.      (normal-feature (make-string len ?\ ))
  302.      (n 0) (i 0)
  303.      (space-list '(?\  ?\t ?\n ?\r))
  304.      (space-regexp "[ \t\n\r]+")
  305.      chr)
  306.     (while (< i len)
  307.       (setq chr (aref routine i)) 
  308.       (cond
  309.        ;; Convert sequences of space characters to a single space.
  310.        ((memq chr space-list)
  311.     (aset normal-feature n ?\ )
  312.     (if (string-match space-regexp routine i)
  313.         (setq i (match-end 0)
  314.           n (1+ n))
  315.       (setq i (1+ i)
  316.         n (1+ n))))
  317.        ;;
  318.        ;; Remove ; style comments
  319.        ((= chr ?\;)
  320.     (setq i (1+ i))
  321.     (while (and (< i len) (/= (aref routine i) ?\n))
  322.       (setq i (1+ i))))
  323.        (t ;; Normal character
  324.     (aset normal-feature n chr)
  325.     (setq i (1+ i)
  326.           n (1+ n)))))
  327.     (substring normal-feature 0 n)))
  328.  
  329. (defun clos-element-tag-list (element-type element arglist-string
  330.                   &optional bwlib-flag)
  331.   "Return list of tags (strings) of ELEMENT-TYPE, ELEMENT and its ARGLIST-STRING.
  332. All three arguments should be strings.
  333. Optional BWLIB-FLAG non-nil means check for BWlib expressions of the form:
  334. \(defmethod class:method-name (args)...)."
  335.   (let* ((element-category (downcase element-type))
  336.      (element-tag-function
  337.       (intern-soft (concat "clos-" element-category "-tag-list")))
  338.      (args (if (or (null arglist-string)
  339.                (string-equal arglist-string ""))
  340.            ""
  341.          (concat " " arglist-string)))
  342.      element-def-and-type)
  343.     (cond ((fboundp element-tag-function)
  344.        ;; If any such function is defined, it must return a list of
  345.        ;; element-tags generated from the defining form, even if it
  346.        ;; generates only 1 tag.
  347.        (funcall element-tag-function element-type element arglist-string))
  348.       ((and bwlib-flag
  349.         (string-match clos-def-form-with-args-regexp element-category)
  350.         (string-match "\\`['\(]?\\([^ \t\n\r]+\\):" element))
  351.        ;; BWlib element definition support
  352.        (list
  353.         (format "%s%s\(%s %s%s"
  354.             (substring element (match-beginning 1) (match-end 1))
  355.             clos-type-tag-separator
  356.             element-type element args)))
  357.       ((equal element-category "defmethod")
  358.        ;; CLOS defmethod
  359.        (let ((arglist (if (string-equal args "")
  360.                   t
  361.                 (read arglist-string)))
  362.          (class)
  363.          (tags))
  364.          (if (nlistp arglist)
  365.          ;; Add to CLOS default 't' class.
  366.          (list (format "t%s\(defmethod %s" 
  367.                    clos-type-tag-separator element))
  368.            ;; If any argument in arglist is itself a list, then this is a
  369.            ;; CLOS method definition with one or more (<arg-name>
  370.            ;; <type-name>) arguments.  We generate one tag for each arg
  371.            ;; list, with the tag's class = <type-name>.  We stop looking
  372.            ;; for specialized arguments if we encounter a keyword
  373.            ;; beginning with '&'.
  374.            (setq tags
  375.              (delq
  376.               nil
  377.               (mapcar
  378.                (function
  379.             (lambda (arg)
  380.               (cond ((null arglist)
  381.                  ;; Encountered &keyword, so ignore rest of
  382.                  ;; args.
  383.                  nil)
  384.                 ((null arg) nil)
  385.                 ((nlistp arg)
  386.                  (and (symbolp arg)
  387.                       (= ?& (aref (symbol-name arg) 0))
  388.                       ;; Encountered &keyword, set up to
  389.                       ;; ignore rest of args.
  390.                       (setq arglist nil)))
  391.                 (t
  392.                  ;; Typed argument
  393.                  (setq class (car (cdr arg)))
  394.                  ;; Type may be of the form: (eql <form>)
  395.                  ;; which is used to compute the type.  We
  396.                  ;; can't compute this here, however, so
  397.                  ;; ignore such types.
  398.                  (if (listp class)
  399.                      nil
  400.                    (setq class (symbol-name class))
  401.                    (format "%s%s\(defmethod %s%s"
  402.                        class clos-type-tag-separator
  403.                        element args))))))
  404.                arglist)))
  405.            (or tags
  406.            ;; Add this method to CLOS default 't' class since none of
  407.            ;; its parameters were specialized.
  408.            (list (format "t%s\(defmethod %s%s" 
  409.                  clos-type-tag-separator element args))))))
  410.       ((setq element-def-and-type (assoc element-category
  411.                          clos-element-type-alist))
  412.        (list (format "[%s]%s\(%s %s%s"
  413.              (cdr element-def-and-type)
  414.              clos-type-tag-separator
  415.              element-type element args)))
  416.       (t (beep)
  417.          (message
  418.           "(clos-element-tag): '%s' is an unknown definition type"
  419.           element-type)
  420.          (sit-for 3)))))
  421.  
  422. (defun clos-feature-tag-class (element-tag)
  423.   "Extract the class name from ELEMENT-TAG."
  424.   (if (string-match (format "\\([^ \t%s]+\\)%s"
  425.                 clos-type-tag-separator
  426.                 clos-type-tag-separator)
  427.             element-tag)
  428.       (substring element-tag (match-beginning 1) (match-end 1))
  429.     ""))
  430.  
  431. (defun clos-files-with-source (class)
  432.   "Use CLASS to compute set of files that match to a clos source file regexp.
  433. Return as a list."
  434.   (let ((file (if class (br-class-path class) buffer-file-name)))
  435.     (and file
  436.      (let* ((src-file-regexp (concat "^" (br-filename-head file)
  437.                      clos-src-file-regexp))
  438.         (dir (file-name-directory file))
  439.         (files (directory-files dir nil src-file-regexp)))
  440.        (mapcar (function (lambda (f) (concat dir f)))
  441.            files)))))
  442.  
  443. (defun clos-find-class-name ()
  444.   "Return current word as a potential class name."
  445.   (save-excursion
  446.     (let* ((start)
  447.        (ignore " \t\n\r ;,\(\){}")
  448.        (pat (concat "^" ignore)))
  449.       (forward-char 1)
  450.       (skip-chars-backward ignore)
  451.       (skip-chars-backward pat)
  452.       (setq start (point))
  453.       (skip-chars-forward (concat pat ":"))
  454.       (buffer-substring start (point)))))
  455.  
  456. (defun clos-get-class-name-from-source ()
  457.   "Return class name from closest class definition preceding point or nil."
  458.   (save-excursion
  459.     (if (re-search-backward clos-class-def-regexp nil t)
  460.     (buffer-substring (match-beginning 1) (match-end 1)))))
  461.  
  462. (defun clos-get-feature-tags (feature-file &optional feature-list)
  463.   "Scan clos FEATURE-FILE and hold feature tags in 'br-feature-tags-file'.
  464. Assume FEATURE-FILE has already been read into a buffer and that
  465. 'br-feature-tags-init' has been called.  Optional FEATURE-LIST can be
  466. provided so that a non-standard scan function can be used before calling
  467. this function."
  468.   (interactive)
  469.   (let ((obuf (current-buffer)))
  470.     (or feature-list
  471.     (setq feature-list (clos-sort-features
  472.                 (nreverse (clos-scan-features)))))
  473.     (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
  474.     (goto-char 1)
  475.     ;; Delete any prior feature tags associated with feature-file
  476.     (if (search-forward feature-file nil 'end)
  477.     (progn (forward-line -1)
  478.            (let ((start (point)))
  479.          (search-forward "\^L" nil 'end 2)
  480.          (backward-char 1)
  481.          (delete-region start (point))
  482.          )))
  483.     (if feature-list
  484.     (progn (insert "\^L\n" feature-file "\n")
  485.            (mapcar (function (lambda (tag) (insert tag "\n")))
  486.                feature-list)))
  487.     (set-buffer obuf)))
  488.  
  489. (defun clos-skip-past-comments ()
  490.   "Skip over comments immediately following point."
  491.   (skip-chars-forward " \t\n")
  492.   (while
  493.       (cond ((looking-at "//")
  494.          (equal (forward-line 1) 0))
  495.         ((looking-at "/\\*")
  496.          (re-search-forward "\\*/" nil t))
  497.         (t nil))))
  498.  
  499. (defun clos-skip-to-statement ()
  500.   (let ((bol (save-excursion (beginning-of-line) (point))))
  501.     (if (save-excursion (search-backward ";" bol t))
  502.     nil  ;; In a comment
  503.       ;; Find definition beginning.
  504.       (re-search-backward "^\(\\|" nil t))))
  505.  
  506. ;;; ************************************************************************
  507. ;;; Private variables
  508. ;;; ************************************************************************
  509.  
  510. (defconst clos-element-identifier
  511.   (let ((identifier "[^][ \t\n\r;,`'{}()]+"))
  512.     ;; Initial optional paren is for defstructs of the form:
  513.     ;; (defstruct (identifier options))
  514.     (concat "['\(]?\\(" identifier
  515.         "\\|(setf[ \t\n\r]+" identifier "[ \t\n\r]*)\\)"
  516.         "\\([ \t\n\r]+'?:" identifier "\\)?"))
  517.   "Regular expression matching a clos element name.
  518. If a method, this includes any method qualifier.  Optional method qualifier
  519. is of the form: :before, :after or :around.  \(setf <slot>) names the writer
  520. method for <slot>.")
  521.  
  522. (defconst clos-comment-regexp "\\([ \t\n\r]*;.*[\n\r]\\)*[ \t\n\r]*")
  523.  
  524. (defvar   clos-element-type-alist
  525.   '(("defconstant"  . "constant")
  526.     ("defconst"     . "constant")
  527.     ("defun"        . "function")
  528.     ("defgeneric"   . "generic")
  529.     ("defmacro"     . "macro")
  530.     ("defmethod"    . "method")
  531.     ("defpackage"   . "package")
  532.     ("defparameter" . "parameter")
  533.     ("defsetf"      . "setfunction")
  534.     ("defstruct"    . "structure")
  535.     ("deftype"      . "type")
  536.     ("defvar"       . "variable")
  537.     ("fset"         . "function"))
  538.   "*Alist of (<element-definition-function-string> . <element-type-string>) elements.
  539.  
  540. Reread the definition of 'clos-def-form-regexp' if you change this variable,
  541. as its value depends on this variable.  You may also need to add to the
  542. definition of 'clos-def-form-with-args-regexp'.")
  543.  
  544. (defconst clos-def-form-regexp
  545.   (mapconcat 'identity (mapcar 'car clos-element-type-alist) "\\|")
  546.   "*Regexp of Common Lisp/Clos form names that define new element types.
  547. Defclass is omitted since the OO-Browser handles that separately.")
  548.  
  549. (defconst clos-def-form-with-args-regexp
  550.   "defun\\|defgeneric\\|defmacro\\|defmethod\\|defsetf\\|fset"
  551.   "*Regexp of Common Lisp/Clos defining forms whose signature includes arguments.")
  552.  
  553. (defconst clos-feature-def-regexp
  554.   (concat "(\\(" clos-def-form-regexp "\\)[ \t\n\r]+\\(\\('?"
  555.       clos-type-identifier ":\\)?"
  556.       "\\(" clos-element-identifier "\\)\\)"
  557.       clos-comment-regexp)
  558.   "Regexp matching a clos element definition.
  559. Defining form, e.g. defun, is group 'clos-def-form-grpn'.
  560. Class plus element name is group 'clos-feature-grpn'.
  561. Class name is group 'clos-feature-type-grpn.
  562. Element name, with optional qualifier but without class, is group
  563. 'clos-feature-name-grpn'.")
  564.  
  565. (defconst clos-def-form-grpn 1)
  566. (defconst clos-feature-grpn 2)
  567. (defconst clos-feature-type-grpn 3)
  568. (defconst clos-feature-name-grpn 4)
  569.  
  570. (defconst clos-element-def (concat "^[ \t]*" clos-feature-def-regexp)
  571.   "Regexp matching a clos element definition.
  572. See 'clos-feature-def-regexp' for grouping definitions.")
  573.  
  574. (defconst clos-arg-identifier (concat "[" clos-identifier-chars "]+")
  575.   "Regular expression matching a clos function argument identifier.")
  576.  
  577. (provide 'br-clos-ft)
  578.